home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2002 November / CD 1 / APC0211D1.ISO / workshop / prog / files / ActivePerl-5.6.1.633-MSWin32.msi / _c384003cb6ab5b9e3e79f4ffc3f11dcd < prev    next >
Encoding:
Text File  |  2002-05-30  |  4.8 KB  |  143 lines
  1.  
  2.  
  3. sub rulerMkTab {
  4.  
  5.     my($c, $x, $y) = @_;
  6.  
  7.     return $c->create('polygon', $x, $y, $x+$ruler_info{'size'}, $y+$ruler_info{'size'}, $x-$ruler_info{'size'},
  8.               $y+$ruler_info{'size'});
  9.  
  10. } # end rulerMkTab
  11.  
  12.  
  13. sub rulerMoveTab {
  14.  
  15.     my($c) = @_;
  16.  
  17.     return if not defined $c->find('withtag', 'active');
  18.     my $e = $c->XEvent;
  19.     my($x, $y) = ($e->x, $e->y);
  20.     my $cx = $c->canvasx($x, $ruler_info{'grid'});
  21.     my $cy = $c->canvasy($y);
  22.     if ($cx < $ruler_info{'left'}) {
  23.     $cx =  $ruler_info{'left'};
  24.     }
  25.     if ($cx > $ruler_info{'right'}) {
  26.     $cx =  $ruler_info{'right'};
  27.     }
  28.     if (($cy >= $ruler_info{'top'}) and ($cy <= $ruler_info{'bottom'})) {
  29.     $cy =  $ruler_info{'top'} + 2;
  30.     $c->itemconfigure('active', @{$ruler_info{'activeStyle'}});
  31.     } else {
  32.     $cy =  $cy - $ruler_info{'size'} - 2;
  33.     $c->itemconfigure('active', @{$ruler_info{'deleteStyle'}});
  34.     }
  35.     $c->move('active',  $cx-$ruler_info{'x'}, $cy-$ruler_info{'y'});
  36.     $ruler_info{'x'} = $cx;
  37.     $ruler_info{'y'} = $cy;
  38.  
  39. } # end rulerMoveTab
  40.  
  41.  
  42. sub rulerNewTab {
  43.     
  44.     my($c) = @_;
  45.  
  46.     my $e = $c->XEvent;
  47.     my($x, $y) = ($e->x, $e->y);
  48.     $c->addtag('active', 'withtag', rulerMkTab($c, $x, $y));
  49.     $c->addtag('tab', 'withtag', 'active');
  50.     $ruler_info{'x'} = $x;
  51.     $ruler_info{'y'} = $y;
  52.     rulerMoveTab($c, $e);
  53.  
  54. } # end rulerNewTab
  55.  
  56.  
  57. sub rulerReleaseTab {
  58.  
  59.     my($c) = @_;
  60.  
  61.     return if not defined $c->find('withtag', 'active');
  62.     if ($ruler_info{'y'} != $ruler_info{'top'} + 2) {
  63.     $c->delete('active');
  64.     } else {
  65.     $c->itemconfigure('active', @{$ruler_info{'normalStyle'}});
  66.     $c->dtag('active');
  67.     }
  68.  
  69. } # end rulerReleaseTab
  70.  
  71.  
  72. sub rulerSelectTab {
  73.  
  74.     my($c) = @_;
  75.  
  76.     my $e = $c->XEvent;
  77.     my($x, $y) = ($e->x, $e->y);
  78.     $ruler_info{'x'} = $c->canvasx($x, $ruler_info{'grid'});
  79.     $ruler_info{'y'} = $ruler_info{'top'} + 2;
  80.     $c->addtag('active', 'withtag', 'current');
  81.     $c->itemconfigure('active', @{$ruler_info{'activeStyle'}});
  82.     $c->raise('active');
  83.  
  84. } # end rulerSelectTab
  85.  
  86. sub mkRuler {
  87.  
  88.     # Create a canvas demonstration consisting of a ruler displays a ruler with tab stops that can be set individually.
  89.  
  90.     $mkRuler->destroy if Exists($mkRuler);
  91.     $mkRuler = $top->Toplevel();
  92.     my $w = $mkRuler;
  93.     dpos $w;
  94.     $w->title('Ruler Demonstration');
  95.     $w->iconname('Ruler');
  96.  
  97.     my $w_msg = $w->Label(-font => '-Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*', -wraplength => '13c',
  98.                  -justify => 'left', -text => 'This canvas widget shows a mock-up of a ruler.  You can create tab ' .
  99.                  'stops by dragging them out of the well to the right of the ruler.  You can also drag ' .
  100.                  'existing tab stops.  If you drag a tab stop far enough up or down so that it turns dim, it ' .
  101.                  'will be deleted when you release the mouse button.');
  102.     my $c = $w->Canvas(-width => '14.8c', -height => '2.5c');
  103.     my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]);
  104.     $w_msg->pack(-side => 'top', -fill => 'x');
  105.     $c->pack(-side => 'top', -fill => 'x');
  106.     $w_ok->pack(-side => 'bottom', -pady => '5');
  107.  
  108.     $ruler_info{'grid'} = '.25c';
  109.     $ruler_info{'left'} = $c->fpixels('1c');
  110.     $ruler_info{'right'} = $c->fpixels('13c');
  111.     $ruler_info{'top'} = $c->fpixels('1c');
  112.     $ruler_info{'bottom'} = $c->fpixels('1.5c');
  113.     $ruler_info{'size'} = $c->fpixels('.2c');
  114.     $ruler_info{'normalStyle'} = [-fill => 'black'];
  115.     if ($mkRuler->depth > 1) {
  116.     $ruler_info{'activeStyle'} = [-fill => 'red',   -stipple => undef];
  117.     $ruler_info{'deleteStyle'} = [-fill => 'red',   -stipple => '@'.Tk->findINC('demos/images/grey.25')];
  118.     } else {
  119.     $ruler_info{'activeStyle'} = [-fill => 'black', -stipple => undef];
  120.     $ruler_info{'deleteStyle'} = [-fill => 'black', -stipple => '@'.Tk->findINC('demos/images/grey.25')];
  121.     }
  122.  
  123.     $c->create(qw(line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1));
  124.     for ($i = 0; $i < 12; $i++) {
  125.     my $x = $i+1;
  126.     $c->create('line', "$x.c",  '1c', "$x.c",  '0.6c', -width => 1);
  127.     $c->create('line', "$x.25c", '1c', "$x.25c", '0.8c', -width => 1);
  128.     $c->create('line', "$x.5c",  '1c', "$x.5c",  '0.7c', -width => 1);
  129.     $c->create('line', "$x.75c", '1c', "$x.75c", '0.8c', -width => 1);
  130.     $c->create('text', "$x.15c", '.75c',-text => $i, -anchor => 'sw');
  131.     }
  132.     $c->addtag('well', 'withtag', $c->create(qw(rect 13.2c 1c 13.8c 0.5c -outline black -fill), ($c->configure(-bg))[4]));
  133.     $c->addtag('well', 'withtag', rulerMkTab($c, $c->pixels('13.5c'), $c->pixels('.65c')));
  134.  
  135.     $c->bind('well', '<1>' => sub{rulerNewTab(@_)});
  136.     $c->bind('tab', '<1>' => sub {rulerSelectTab(@_)});
  137.     $c->Tk::bind('<B1-Motion>' => sub {rulerMoveTab(@_)});
  138.     $c->Tk::bind('<Any-ButtonRelease-1>', sub {rulerReleaseTab(@_)});
  139.  
  140. } # end mkRuler
  141.  
  142. 1;
  143.